Matka GPS blogi interaktiivsele kaartile: Norra rattamatk 2017

Ronimine meile meeldib! Ülo ja Intsu mõtisklevad möödunud päeva üle Håra lähedal laagris. Selja taga on kõigest natuke üle 60 km, aga 1260 tõusumeetrit. 17. juuli 2017.

Marsruut

Norra rattamatk alguse ja lõpuga Tallinnast, 2017-07-10 kuni 2017-07-21. Auto ja laevaga Tallinn–Stockholm–Geilo ja tagasi 10-11. ja 20-21. juuli. Ratastega Geilo–Voss ring 12-19. juuli. Rongiga Voss–Geilo.

Träkkimine

Jalgrattamarsruuti träkkisin Suunto Ambit 2 kellaga. Aku tööaja pikendamiseks kasutasin 10 s salvestusintervalle ja ‘OK’ GPS täpsussetingut, mis peaks tagama ~50 tunnise patarei kasutusaja. Pika salvestusintervalli tõttu ei jookse GPS rada kaartile panduna alati täpselt mööda teid, vaid kipub kurve sirgeks lõikama, mis on muidugi minoorne puudus.

Proovime selle marsruudi päevade kaupa kokku panna ja kaartile joonistada koos kõrgusprofiiliga.

GPS rada kaartile

Tegelikult piisab selleks mõnest koodireast, kui kasutada R pakette leaflet ja leaflet.extras. Kõige pealt laadin Suunto Movescount võrgulehelt alla .gpx track failid ja salvestan nad oma arvutisse kataloogi nimega data/.

GPX failidest saab importida R-i GPS andmed GIS formaati näiteks kasutades readOGR funktsiooni paketist rgdal. Imporditud rajajooned/rajapunktid on Spatial klassi objektid, mida saab siis R-is edasi töödelda ja analüüsida kasutades näiteks sp või rgdal paketi tööriistu.

Mina kavatsen aga kasutada otse GPX andmete lisamiseks leaflet kaartile leaflet.extras paketi funktsiooni addGPX, mis võtab andmed kas a) gpx failist või b) gpx xml stringist (pikk xml formaadis lause). Niimoodi saan ma kasutada algseid andmeid ja jääb ära andmete vahepealne konverteerimine SpatialLines, SpatialPointsDataFrame või muusse sellisesse objekti.

Kui on soov eri failides olevaid radasid ühendada

Mõnel päeval salvestasin ma mitu träkki: näiteks enne lõunapausi ja peale lõunapausi. Liidan need träkid päevakaupa kokku.

Laadime vajalikud library-d ja kaks abifunktsiooni.

library(tidyverse)

## Warning: package 'dplyr' was built under R version 3.4.2

library(viridis)
library(stringr)
library(leaflet)
library(leaflet.extras) # fullscreen control button
library(jsonlite)
library(htmltools)
library(htmlwidgets)
source("lib/tidy_gpx.R")
source("lib/extract_date.R")

Alustuseks moodustan gpx faili nimedest ja nende nimes olevatest kuupäevadest data_frame-i. Seejärel grupeerin failinimed kuupäevade järgi listidesse ja ühendan omavahel otsapidi iga kuupäeva päevateekonnad. Lisan legendi jaoks tabelisse ka ‘käsitsi’ kokku pandud päevateekondade algus- ja lõpp-punktid. Lõpuks konverteerin dataframe-d json formaati.

## List gpx files in data folder
tracks <- data_frame(gpx_files = list.files("data/", full.names = T))
## Extract dates and convert gpx to dataframe
tracks <- mutate(tracks, date = extract_date(gpx_files),
                 gpx_strings = map(gpx_files, read_file),
                 gpx_df = map(gpx_strings, tidy_gpx))
## Merge days tracks
tracks_merged <- tracks %>%
  group_by(date) %>%
  do(gpx_df = bind_rows(.$gpx_df)) %>%
  ungroup()
## Add legend to tracks
tracks_merged$trip  <- c("Geilo-Nedra Grøndalsvatne (Rallarvegen)",
                  "Nedra Grøndalsvatne-Voss-Dalavegen",
                  "Dalavegen-Stanghelle-Bergen (train)-Lyseklostervegen",
                  "Lyseklostervegen-Buavågen",
                  "Buavågen-Saudavegen",
                  "Saudavegen-Sauda-Håra",
                  "Håra-Odda-Utne",
                  "Kvanndal-Voss")

geojson_body <- '{"type":"Feature","geometry":{"type":"LineString","coordinates":%s},"properties":null}'

## Drop time from tracks dataframes 
## Calculate coordinates for boundingbox bb
## Extract coordinates
## add coordinates to geojson body
## reformat geojson
tracks_merged <- mutate(tracks_merged, 
                        gpx_df = map(gpx_df, ~select(.x, lon, lat, ele)), 
                        bb = map(gpx_df, ~summarise_at(.x, c("lon", "lat"), c("min", "max"))),
                        coordinates = map(gpx_df, ~toJSON(.x, dataframe = "values")), 
                        geojson = sprintf(geojson_body, coordinates), 
                        geojson = map(geojson, ~toJSON(fromJSON(.x), auto_unbox = T)))

Arvutame summaarse tõusu ja laskumise iga päeva kohta

Kasutades gpx kõrgusandmeid (ele) arvutame kui palju sai iga päev mäest ülesse ronitud ja kui palju alla lastud.

## Calculate daily asc and desc
tracks_gat <- tracks_merged %>% 
  mutate(ele = map(gpx_df, "ele"),
         asc = map_dbl(ele, ~sum(diff(.x)[diff(.x)>0])),
         desc = map_dbl(ele, ~abs(sum(diff(.x)[diff(.x)<0])))) %>% 
  select(date, trip, asc, desc) %>% 
  gather(key, value, asc, desc)

ggplot(tracks_gat, aes(str_wrap(paste(date, trip, sep = ", "), 30), value, fill = key)) + 
  geom_bar(stat = 'identity', position = 'dodge') +
  coord_flip() + 
  ylab("Summed value, meters") +
  scale_fill_viridis(discrete = TRUE, labels = c("Ascent", "Descent")) +
  theme(axis.title.y = element_blank(),
        legend.title = element_blank(),
        legend.background = element_blank())

Summaarne päeva tõus ja laskumine.

Lisame kaartile fotod

Lisan tabelisse ka matka jooksul paar telefoniga tehtud tehtud fotot, millel on positsiooni info olemas. Positsiooneerimisinfo võtan fotode infost välja kasutades käsureaprogrammi exiftool, mille olen jälle pakendanud R-i funktsioonina: exif_location. Alternatiivselt võib ligikaudse positsioneerimise tuletada foto tegemise kellaajast. Fotod saab lisada leaflet-is markerite popup-idesse, milleks tuleb fotode pathid pakendada HTML-ina, minimaalselt näiteks <img src="path-to-photo/" /> ja anda funktsioonile pildi koordinaadid.

# Get list of photos
photos <- list.files("photos/", full.names = TRUE)
# Function to extract location info from exif data
exif_location <- function(path) {
  # Read GPS locaton using exiftool
  exif_cmd <- paste("exiftool -c '%.6f'", path, "| grep 'GPS Position'")  
  location <- system(exif_cmd, intern = TRUE, ignore.stderr = TRUE) # execute exiftool-command
  location <- stringr::str_extract_all(location, "[0-9]+\\.[0-9]+") %>%
    unlist %>% 
    vapply(as.numeric, FUN.VALUE =  double(1), USE.NAMES = FALSE) 
  
  if(length(location)!=2){
    warning("Location data not found!")
    location <- c(NA, NA)
  }
  
  names(location) <- c("lat","lon")
  location <- c(path = path, location)
  return(location)
}
# Extract gps data from exif
photos_location <- lapply(photos, exif_location)
# Munge location data
photos_location <- do.call(rbind, photos_location) %>% 
  as_tibble() %>% 
  filter(complete.cases(.)) %>% 
  mutate_at(c("lat","lon"), as.numeric)
# Create popup
photos_location <- mutate(photos_location, 
                          date = extract_date(path),
                          popup = sprintf("<img src='%s' style='height:252px;width:448px;' />
                                          <p>Foto: Taavi Päll</p>", path))
# Nest data necessary to display photo on map into data_frame
photos_location <- nest(photos_location, path, lat, lon, popup, .key = "popupdata")
# Join photos data to tracks
tracks_merged <- left_join(tracks_merged, photos_location)

Päevateekonnad

Plotime oma ettevalmistatud andmed kasutades paketti leaflet. Kaartikihte saab lisada funktsiooniga addTiles või addProviderTiles. Saadaolevaid kaarte näitavad käsud providers ja providers.details.

# Let's have a look at some map providers
sample(providers, 6)

## $OpenWeatherMap.Temperature
## [1] "OpenWeatherMap.Temperature"
## 
## $HERE.basicMap
## [1] "HERE.basicMap"
## 
## $Esri.NatGeoWorldMap
## [1] "Esri.NatGeoWorldMap"
## 
## $OpenMapSurfer.Roads
## [1] "OpenMapSurfer.Roads"
## 
## $BasemapAT.orthofoto
## [1] "BasemapAT.orthofoto"
## 
## $OpenStreetMap.Mapnik
## [1] "OpenStreetMap.Mapnik"

leaflet-i kaart koostatakse kiht-kihilt. Iga päeva distantsi kanname eraldi kaartile, lisame kõrgusprofiili, legendi ja fotod, kui need on olemas.

Kõrgusprofiili lisamiseks on leaflet javascript programmile olemas plugin L.control.elevation, mis pole aga R-i jaoks implementeeritud. Lisaks vajab see plugin (loomulikult!) kõrgusinfot, mis paistab minevat kaduma, kui kasutada leaflet.extras paketi funktsiooni addGPX (viimane kasutab leafleti omnivore pluginat, mis GPX andmete puhul kõrgusinfot ei impordi). See tähendab, et tuleb kasutada üht teist leaflet GPX pluginat, mis impordib ka altituudi: leaflet-gpx. Aga ka see plugin pole R-i jaoks implementeeritud. Lahenduseks on need pluginad javascripti kujul leafleti R funktsiooni lisada, nagu on näidatud siin: https://gist.github.com/jcheng5/c084a59717f18e947a17955007dc5f92, kasutades htmlwidgets::onRender funktsiooni. Soovitav on enne kontrollida veebibrauseris kas lisatav JS ka muidu töötab.

API keys

Mitmed kaartikihtide pakkujad nt. thunderforest tahavad registreerimist. Ilma registreerimiseta näidatakse kaartil tüütut vesimärki. Thunderforestil on väikeses mahus kasutamine tasuta ja registreerimisel antakse unikaalne API key, mis tuleb kaarti URL-i lõppu lisada kujul ?apikey=your-unique-apikey (vt. ka allpool olevat koodi). Et mitte oma isiklikku apikey-d tervele internetile avalikuks teha, tuleks see lisada R-i environment variable-ks, kust selle saab kätte kasutades käsku Sys.getenv(). Käimasolevasse R-i sessiooni environmenti saab apikey lisada kasutades Sys.setenv(THUNDERF_APIKEY = "your-unique-apikey") käsku (thunderforest-i näitel). Sellisel juhul läheb see R-ist väljumisel muidugi kaotsi ja tuleb taaskäivitamisel uuesti lisada. Permanentselt saab sellise apikey lisada oma R-i environmenti kirjutades selle rea (THUNDERF_APIKEY = “your-unique-apikey”) .Renviron faili.

# Use fa icon
icon_fa_camera <- makeAwesomeIcon(icon = 'camera', 
                                  markerColor = 'red',
                                  library='fa',
                                  iconColor = 'black')

# A function that takes a plugin htmlDependency object and adds
# it to the map. This ensures that however or whenever the map
# gets rendered, the plugin will be loaded into the browser.
registerPlugin <- function(map, plugin) {
  map$dependencies <- c(map$dependencies, list(plugin))
  map
}

# Plotting function
#' @param json character string, either gpx xml or gpx file name.
#' @param bb data frame with bounding box coordinates lng1, lat1, lng2, lat2.
#' @param trip character string with trip legend.
#' @param popupdata tibble with track annotations, photos, etc.
plot_trip2 <- function(json, bb, trip = NULL, popupdata = NULL){
  
  # Thunderforest base url
  thunderforest_link_template <- "https://{s}.tile.thunderforest.com/%s/{z}/{x}/{y}.png?apikey=%s"
  
  # Compose map
  m <- leaflet() %>%
    
    ## Fit boundingbox
    fitBounds(lng1 = bb[[1]], 
              lat1 = bb[[2]], 
              lng2 = bb[[3]], 
              lat2 = bb[[4]]) %>%
    
    # Add tiles
    addTiles(sprintf(thunderforest_link_template, "landscape", Sys.getenv("THUNDERF_APIKEY")), group = "Topograafiline") %>%
    addTiles(sprintf(thunderforest_link_template, "cycle", Sys.getenv("THUNDERF_APIKEY")), group = "Rattateed") %>%
    addTiles(sprintf(thunderforest_link_template, "outdoors", Sys.getenv("THUNDERF_APIKEY")), group = "Matka- ja terviserajad") %>%
    addProviderTiles("OpenStreetMap.Mapnik", group = "Sõiduteed", options = providerTileOptions(detectRetina = T)) %>%
    addProviderTiles("Esri.WorldImagery", group = "Satelliit", options = providerTileOptions(detectRetina = T))
  
  ## JS plugins
  elevationPlugin <- htmlDependency("Leaflet.elevation", "0.0.4",
      src = normalizePath("js/elevation/"),
      script = "leaflet.elevation-0.0.4.src.js",
      stylesheet = "leaflet.elevation-0.0.4.css")
  
  d3Plugin <- htmlDependency("d3", "3.5.17",
      src = normalizePath("js/d3/"),
      script = "d3.js")
  
  # Add data
  m <- m %>%
    # Register plugins on this map instance
    registerPlugin(d3Plugin) %>% 
    registerPlugin(elevationPlugin) %>%
    # Add your custom JS logic here. The `this` keyword
    # refers to the Leaflet (JS) map object.
    onRender('function(el, x, data) {

          var elev = L.control.elevation({
              theme: "lime-theme",
              width: 300
          });
              elev.addTo(this);
          
          L.geoJson(data, {
              onEachFeature: elev.addData.bind(elev)
              }).addTo(this);}', data = json)
  
  # Add legend
  if(!is.null(trip)){
    m <- m %>% addLegend(position = 'bottomright', 
                         opacity = 0.4, 
                         colors = 'blue', 
                         labels = trip,
                         title = 'Norra 2017')}
  
  # Add photo markers
  if(!is.null(popupdata)){
    m <- m %>% addAwesomeMarkers(lng = popupdata$lon,
                                 lat = popupdata$lat,
                                 popup = popupdata$popup,
                                 popupOptions = popupOptions(closeButton = TRUE, 
                                                             maxWidth = 500,
                                                             closeOnClick = TRUE),
                                 icon = icon_fa_camera,
                                 group = 'Fotod')
  }
  
  # Layers control
  m %>% addLayersControl(position = 'bottomright',
                         baseGroups = c("Topograafiline", 
                                        "Sõiduteed", 
                                        "Rattateed", 
                                        "Matka- ja terviserajad",  
                                        "Satelliit"),
                         # overlayGroups = c("Rattamarsruut", "Fotod"),
                         options = layersControlOptions(collapsed = TRUE)) %>%
    
    # Add a fullscreen control button
    addFullscreenControl()
}

Iga päeva distantsi kanname eraldi kaartile, lisame legendi ja fotod, kui need on olemas.

tracks_merged <- mutate(tracks_merged, trip_leaf = pmap(list(geojson, bb, trip, popupdata), plot_trip2))

Üksikuid kaarte näeb tracks data_frame-st niimoodi, tuleb valida trip_leaf list/tulp ja sealt subsettida:

tracks_merged$trip_leaf[[1]]

Erinevaid aluskaarte saab valida alt paremast nurgast (legendi kohal), kursoriga aktiveeritavast menüüst.

K, 12. juuli

Esimesel päeval sai kogemata hullu pandud ja kogu Rallarvägen ühe raksuga läbi sõidetud. Alguses sai suvise aasa servas õlut juua, hiljem tuli ratast läbi lume tassida.

N, 13. juuli

Myrdali ja Utne vahel tuli sõita üks peatus rongiga, läbi tunneli. Pangakaartiga on rongis tunnelis sõites pileti ostmine problemaatiline, mistõttu saime lausa tasuta:-)

R, 14. juuli

Stanghelles oli plaan praamiga teisele kaldale sõita ja rattaga Bergenisse vändata, kuid selle ülesõidu oleks pidanud juba varem kokku leppima/tellima. Seega sõitsime rongiga otse Bergenisse. Ööbisime kloostri taga metsas, suht literaalselt.

L, 15. juuli

Päev algas ekslemise ja sadama otsimisega. Ööbima jäime vihma tõttu ühte pisikesse sadamasse, kõigi mugavustega sadamamajakesse.

P, 16. juuli

Hoogtöö päev. Sai sõidetud 100 km ja üle 1000 m ronitud. Unistasime õllest.

E, 17. juuli

Kõrgel on ilus - ronimise päev. Sai sõidetud pea poole vähem kui eelmisel päeval, kuid see eest rohkem ronida. Trackis on vahepeal katkestus, sest unustasin kella sisse lülitada, olid kõige magusamad ronimispalad.

T, 18. juuli

Allamäge. Päev algas küll korraliku ronimise ja 4+km pikkuse tunneliga, kuid hiljem oli ainult allamäge veeremine. Tundus, et läbisime Norra puuviljakasvatuspiirkonda - kõikjal olid mureli- ja pirniaiad.

K, 19. juuli

Tagasi Vossi rongi peale. Teepeal nägime paari turistilõksu ja peldikut, mis mõjus nagu pühamu.